home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / prlbkxmp.lha / ch2 / pigeons < prev    next >
Text File  |  1991-01-07  |  2KB  |  57 lines
  1. #!/usr/bin/perl
  2.  
  3. # We put any configuration constants here in front.  It helps
  4. # to capitalize them for visibility later in the program.
  5.  
  6. $RECLEN = 8;
  7.  
  8. # Note how we can assign a list of pairs to an entire
  9. # associative array in order to initialize it.
  10.  
  11. %fullname = (
  12.     'sh', 'sheep',
  13.     'ca', 'camels',
  14.     'ox', 'oxen',
  15.     'do', 'donkeys',
  16.     'so', 'sons',
  17.     'da', 'daughters',
  18. );
  19.  
  20. # Open the files (devices, in this case).
  21.  
  22. open(PCTR, "</dev/pctr")
  23.     || die "Couldn't open pigeon's clay tablet reader: $!\n";
  24. open(PCTW, ">/dev/pctw")
  25.     || die "Couldn't open pigeon's clay tablet writer: $!\n";
  26.  
  27. # Main loop.  This loop runs till last pigeon brings EOF tablet.
  28.  
  29. for ($recnum = 0; read(PCTR, $record, $RECSIZE); $recnum++) {
  30.  
  31.     # Break apart the record into its fields.
  32.  
  33.     ($beastie, $count) = unpack("A2 A6", $record);
  34.  
  35.     # Add the count into the proper associative array entry.
  36.     # Note that $count may be negative, in which case the
  37.     # entry is decreased by the += operator.
  38.  
  39.     $count{$beastie} += $count;
  40.  
  41.     # Print out the acknowledgement for the return pigeon.
  42.     # Instead of sending a count back, we send back the record
  43.     # number, for the beastie keepers to check off as received.
  44.     # $newrec is guaranteed to be exactly 8 bytes long.
  45.  
  46.     $newrec = pack("A2 A6", $beastie, $recnum);
  47.     print PCTW $newrec;
  48. }
  49.  
  50. # End-of-Day processing.  We translate the abbreviated beastie
  51. # name back to the full name to print it out, along with the
  52. # accumulated count for the day.
  53.  
  54. foreach $key (sort keys(%count)) {
  55.     printf "%-20s %d\n", $fullname{$key}, $count{$key};
  56. }
  57.